home *** CD-ROM | disk | FTP | other *** search
- program GenieDir;{November 30,1986;Dec 14,86;Feb22,87}
- USES MacIntf;
- {$L DirMassage/Rsrc}
- {$T 'APPL' 'TMLP'}
- const {menu ids}
- appleMenu = 1000; {DA menu}
- FileMenu = 1001;
- MassMenu = 1002;
- lastMenu = 3;
- dialogHook = nil;
- fileFilter = nil; {for SFroutines}
- numTypes = 1;
-
- var
- done : boolean;
- finish : text; {for output file}
- firstline : string; {from input file}
- index : integer;
- initText : string; {prompt}
- item : array[0..7] of string;
- myMenus : array[1..lastMenu] of MenuHandle;
- promptString: string;
- reply: SFReply;
- secondline : string; {from input file}
- typeList: SFTypeList;
- source : text; {input file}
- theDialog: DialogPtr;
- theEvt: EventRecord;
- theWindow : WindowPtr;
- topLeft: Point; {for minifinder box}
-
- procedure SetUpMenus;
- var
- i : integer;
- begin {procedure SetUpMenus}
- InitMenus;
- myMenus[1] := GetMenu(appleMenu);
- myMenus[2] := GetMenu(fileMenu);
- myMenus[3] := GetMenu(MassMenu);
- AddResMenu(myMenus[1],'DRVR');
- for i := 1 to lastMenu do
- InsertMenu(myMenus[i],0);
- DrawMenuBar;
- end; {of procedure SetUpMenus}
- procedure SetUpSys;
- begin {procedure SetUpSys}
- InitGraf(@thePort);
- InitFonts;
- InitWindows;
- TEInit;
- InitDialogs(nil);
- SetEventMask(everyEvent);
- FlushEvents(everyEvent,0);
- SetUpMenus;
- InitCursor;
- done := false;
- end; {ofprocedure SetUpSys}
- Procedure UpdateSys;
- begin {Procedure UpdateSys}
- SystemTask;
- end; {Procedure UpdateSys}
- procedure QuitFile;
- begin
- done := true;
- end;
- procedure find;
- var
- hmm : string;
- yet : boolean;
- begin{procedure find}
- repeat
- yet := false; {do we have a legit first line?}
- readln(source, firstline);
- if length(firstline) < 4 then {this isn't it, but let's don't bomb}
- firstline := 'xxxx';
- hmm := copy(firstline,4,1); {does it look like a serial number?}
- if ((hmm >'/')and(hmm<':')) then
- yet := true;
- if eof(source) then yet := true;
- until yet;
- if eof(source) then
- secondline := ' Desc: lost the description' {so we'll always have a secondline}
- else
- readln(source, secondline);
- end; {of procedure find}
- procedure peel;
- var
- index : integer;
- begin {procedure peel}
- item[0] := copy(firstline, 1, 6); {serial number}
- item[1] := copy(firstline, 7, 25); {name}
- item[2] := copy(firstline, 32, 15); {type & source}
- item[3] := copy(firstline, 47, 7); {date}
- item[4] := copy(firstline, 54, 8); {size}
- item[5] := copy(firstline, 62, 7); {accesses}
- item[6] := copy(firstline, 69, 3); {library number}
- item[7] := copy(secondline, 13, length(secondline)); {the Desc: take it all}
- for index := 0 to 7 do
- begin{cut spaces}
- while pos(' ', item[index]) = 1 do
- delete(item[index], 1, 1);
- while (copy(item[index], length(item[index]), 1) = ' ') do
- delete(item[index], length(item[index]), 1);
- end;{of cut spaces}
- end; {of procedure peel}
-
- procedure Massage;
- begin {procedure Massage}
- promptString:='Which to massage?'; {too bad this doesn't show up in the minifinder box}
- with topLeft do
- begin h:= 20;v:=20 end;
- TypeList[0] := 'TEXT';
- SFGetFile(topLeft,promptString,fileFilter,numTypes,typeList,dialogHook,reply);
- if reply.good then
- begin {anything to do}
- Reset(source, reply.fName);
- promptString := 'Choose Directory Name';
- initText := concat(reply.fName,'.Dir');
- SFPutFile(topLeft, promptString,initText,dialogHook,reply);
- rewrite(finish, reply.fName);
- if reply.good then begin {still something to do}
- while not eof(source) do
- begin {write an entry}
- find;
- peel;
- for index := 0 to 6 do
- write(finish, item[index],chr(9)); {tab delimit the fields}
- writeln(finish, item[7]); {CarriageReturn delimit the records}
- end; {of write an entry}
- close(finish);
- end; {of still something}
- close(source);
- end; {of anything to do}
- end;{ofprocedure Massage}
- procedure DoAppleMenu(theItem : integer);
- var
- refNum : integer;
- name : Str255;
- begin
- if theItem = 1 then
- theItem := Alert(1004, nil)
- else
- begin
- GetItem(myMenus[1], theItem, name);
- refNum := OpenDeskAcc(name);
- end;
- end; {of procedure DoAppleMenu}
- procedure DoFileMenu(theItem : integer);
- begin
- case theItem of
- 1 : QuitFile;
- end; {of case}
- end; {of procedure DoFileMenu}
- procedure DoMassMenu(theItem : integer);
- begin
- case theItem of
- 1 : Massage;
- end; {of case}
- end; {of procedureDoMassMenu}
- procedure SelectMenu(selection : longint);
- begin {procedure SelectMenu}
- case HiWord(selection) of
- appleMenu: DoAppleMenu(LoWord(selection));
- FileMenu: DoFileMenu(LoWord(selection));
- MassMenu : DoMassMenu(LoWord(selection));
- end;
- HiLiteMenu(0);
- end;{of procedure SelectMenu}
- procedure KeyEvent (theKey : char);
- begin
- if BitTst(@theEvt.modifiers, 7) then {check for command key}
- SelectMenu(MenuKey(theKey));
- end; {of KeyEvent}
- procedure WindowUpdate;
- begin {procedure WindowUpdate}
- theWindow := windowPtr(theEvt.message);
- SetPort(theWindow);
- EraseRect(theWindow^.portRect);
- DrawControls(theWindow);
- DrawGrowIcon(theWindow);
- EndUpdate(theWindow);
- end; {of procedure WindowUpdate}
- procedure WindowActivate;
- begin {procedure WindowActivate}
- WindowUpdate;
- end; {of procedure WindowActivate}
-
- begin {main program}
- SetUpSys;
- repeat
- UpdateSys;
- if GetNextEvent(everyEvent,theEvt) then
- case theEvt.what of
- mouseDown: case FindWindow(theEvt.where, theWindow) of
- inMenuBar : SelectMenu(MenuSelect(theEvt.where));
- inSysWindow : SystemClick(theEvt, theWindow);
- end;
- keyDown,autoKey: KeyEvent(Chr(theEvt.message mod 256));
- updateEvt : WindowUpdate;
- activateEvt : WindowActivate;
- end; {of case theEvt}
- until done;
- end.